home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / CSSPECIA.I < prev    next >
Text File  |  1991-12-14  |  33KB  |  1,013 lines
  1. IMPLEMENTATION MODULE CSspecial;
  2.  
  3. FROM BezierCurve     IMPORT ComputeRealBezier;
  4. FROM Dialoge         IMPORT BusyStart, BusyEnd;
  5. FROM Diverses        IMPORT round, GetFSelText, NumAlert, min, max;
  6. FROM FileIO          IMPORT Fopen, EOF, AgainChar, Reset, Close, ReadChar,
  7.                             ReadLn, AgainLine, Rewrite, WriteLn;
  8. FROM ObjectUtilities IMPORT FillObject;
  9. FROM Types           IMPORT TextPosTyp, DrawObjectTyp,
  10.                             LatexSpecials,
  11.                             CodeAryTyp, ObjectPtrTyp;
  12. FROM SYSTEM          IMPORT BYTE, WORD, ADDRESS , ADR ;
  13. FROM Storage         IMPORT ALLOCATE , DEALLOCATE ;
  14. IMPORT CommonData ;
  15. IMPORT GetFile;
  16. IMPORT MathLib0 ;
  17. IMPORT MagicConvert ;
  18. IMPORT MagicDOS ;
  19. IMPORT MagicStrings ;
  20. IMPORT MagicSys ;
  21. IMPORT Variablen ;
  22. IMPORT mtAlerts;
  23. (**
  24. IMPORT Debug;
  25. IMPORT RTD;
  26. **)
  27.  
  28. (**
  29. VAR UseCSspecial : BOOLEAN;
  30. **)
  31.  
  32. CONST CSBug  = TRUE;  (* Sobald Treiber Werte der unit mit Vorfaktoren *)
  33.       BugMsg = FALSE; (* erkennen auf FALSE setzen... (für cond.comp.) *)
  34.  
  35. TYPE  chset = SET OF CHAR;
  36. CONST Magic            = -29564;   (* Test auf ungültige Zahl *)
  37.       FMagic           = -29564.0; (* Test auf ungültige Zahl *)
  38.       Integers         = chset{'0'..'9','+','-'};
  39.       Reals            = chset{'0'..'9','+','-','.'};
  40.       CS1Idlong        = 'CS-Graphics V 1';
  41. (*
  42.       CS2Idlong        = 'CS-Graphics V 2';
  43. *)
  44.       CSIdshort        = 'CS-Graphics';
  45.  
  46. VAR FileHandle, oldlineval, oldthickval : INTEGER;
  47.  
  48. (* $D+*)
  49. PROCEDURE OpenFile(REF FileName : ARRAY OF CHAR);
  50. VAR Line, temp : ARRAY [0..29] OF CHAR;
  51. BEGIN
  52.   Rewrite(FileHandle, FileName);
  53. (*
  54.   IF CommonData.Usespecial = cstrunk2 THEN
  55.     WriteLn(FileHandle, CS2Idlong);
  56.    ELSE
  57.     WriteLn(FileHandle, CS1Idlong);
  58.   END;
  59. *)
  60.   WriteLn(FileHandle, CS1Idlong);
  61.   WriteLn(FileHandle, "% Created by TeX-Draw by Jens Pirnay");
  62.   temp := "r";
  63.   WriteLn(FileHandle, temp); (* Reset *)
  64. (*$? CSBug AND BugMsg:
  65.   WriteLn(FileHandle, "% Bug in Driver? Only pure units e.g. 1mm are recognized!"); (* Reset *)
  66. *)
  67. (*$? CSBug:
  68.   Line := 'u 1';
  69. *)
  70. (*$? NOT CSBug:
  71.   Line := 'u ';
  72.   Variablen.FactorToStr(temp);
  73.   MagicStrings.Append ( temp, Line);
  74. *)
  75.   Variablen.UnitToStr(temp);
  76.   MagicStrings.Append ( temp, Line);
  77.   WriteLn(FileHandle, Line); (* Unitlength *)
  78.   oldlineval  := 0;
  79.   oldthickval := 1; (* 0.4 pt *)
  80. END OpenFile;
  81. (* $D-*)
  82.  
  83. PROCEDURE Do1Line (x : INTEGER; VAR temp : ARRAY OF CHAR);
  84. VAR i : INTEGER; found : INTEGER;
  85. BEGIN
  86. (*$?     CSBug:  Variablen.ValueToStr       ( x , temp ) ; *)
  87. (*$? NOT CSBug:  Variablen.SimpleValueToStr ( x , temp ) ; *)
  88.  END Do1Line;
  89.  
  90. PROCEDURE DoLine(x1, y1, x2, y2 : INTEGER);
  91. VAR line : ARRAY [0..255] OF CHAR;
  92.     temp : ARRAY [0..19] OF CHAR;
  93.  
  94.  
  95. BEGIN
  96.   Do1Line(x1, line);
  97.   Do1Line(y1, temp);
  98.   MagicStrings.Append(' ', line);
  99.   MagicStrings.Append(temp, line);
  100.   MagicStrings.Append(' l ', line);
  101.   Do1Line(x2-x1, temp);
  102.   MagicStrings.Append(temp, line);
  103.   Do1Line(y2-y1, temp);
  104.   MagicStrings.Append(' ', line);
  105.   MagicStrings.Append(temp, line);
  106.   WriteLn(FileHandle, line);
  107. END DoLine;
  108.  
  109. PROCEDURE DoBetterLine(x1, y1, x2, y2 : MagicSys.lINTEGER);
  110. (* Werte sind das 10-fache des normalen *)
  111. VAR line : ARRAY [0..255] OF CHAR;
  112.     temp : ARRAY [0..19] OF CHAR;
  113.  
  114.   PROCEDURE Do10Line (x : MagicSys.lINTEGER; VAR temp : ARRAY OF CHAR);
  115.   VAR i : CARDINAL; found : BOOLEAN;
  116.   BEGIN
  117. (*$?     CSBug:  Variablen.Value10ToStr       ( x , temp ) ; *)
  118. (*$? NOT CSBug:  Variablen.SimpleValue10ToStr ( x , temp ) ; *)
  119. (**
  120.    (* Aus 30.12 wird nun 3.012 *)
  121.     i := 0;
  122.     found := FALSE;
  123.     REPEAT
  124.       IF (temp[i] = '.') THEN
  125.         found := TRUE;
  126.         IF (i>0) THEN
  127.           temp[i  ] := temp[i-1];
  128.           temp[i-1] := '.';
  129.           (* CS mag kein .3 sondern will 0.3 *)
  130.           IF (i-1 = 0) THEN
  131.             MagicStrings.Insert('0', temp, i-1);
  132.            ELSE
  133.             (* Keine Zahl ? Vorzeichen o.ä. ? *)
  134.             IF NOT ((temp[i-2]>='0') AND (temp[i-2]<='9')) THEN
  135.               MagicStrings.Insert('0', temp, i-1);
  136.             END;
  137.           END;
  138.  
  139.          ELSE
  140.           MagicStrings.Insert('0', temp, 1);
  141.         END;
  142.       END;
  143.       INC(i);
  144.     UNTIL (i>=LENGTH(temp)) OR found;
  145.     IF NOT found THEN
  146.       (* Aus 30 wird 3.0 *)
  147.       i := LENGTH(temp);
  148.       temp[i+1] := 0C; (* um eins länger *)
  149.       temp[i  ] := temp[i-1];
  150.       temp[i-1] := '.';
  151.     END;
  152. **)
  153.   END Do10Line;
  154.  
  155. BEGIN
  156.   Do10Line(x1, line);
  157.   Do10Line(y1, temp);
  158.   MagicStrings.Append(' ', line);
  159.   MagicStrings.Append(temp, line);
  160.   Do10Line(x2-x1, temp);
  161.   MagicStrings.Append(' l ', line);
  162.   MagicStrings.Append(temp, line);
  163.   Do10Line(y2-y1, temp);
  164.   MagicStrings.Append(' ', line);
  165.   MagicStrings.Append(temp, line);
  166.   WriteLn(FileHandle, line);
  167. END DoBetterLine;
  168.  
  169. PROCEDURE DoIt ( Object  : ObjectPtrTyp;
  170.                  dx, dy  : INTEGER ) ;
  171. CONST deltaangle = 3;
  172. VAR txt                      : ARRAY [0..9] OF CHAR;
  173.     FirstX, FirstY, x, y, i  : INTEGER;
  174.     startangle, endangle     : INTEGER;
  175.     xradius, yradius         : INTEGER;
  176.     CurrX, CurrY, OldX, OldY : MagicSys.lINTEGER;
  177.     x1,  x2,  x3,  x4   : INTEGER;
  178.     px1, px2, px3, px4  : INTEGER;
  179.     y1,  y2,  y3,  y4   : INTEGER;
  180.     py1, py2, py3, py4  : INTEGER;
  181.  
  182.   PROCEDURE myentier ( x : LONGREAL ) : MagicSys.lINTEGER;
  183.   VAR result: MagicSys.lINTEGER;
  184.   BEGIN
  185.     result := INT(ABS(x) + 0.5);
  186.     IF x<0.0 THEN
  187.       RETURN -result;
  188.      ELSE
  189.       RETURN result;
  190.     END;
  191.   END myentier;
  192.  
  193.  
  194.   PROCEDURE WriteBezier(anzahl, x1, y1, x2, y2, x3, y3 : INTEGER);
  195.   CONST MaxBezPts = 1000;
  196.   VAR Number      : ARRAY [0..19] OF CHAR;
  197.       BezierArray : ARRAY [0..2*MaxBezPts+1] OF LONGREAL;
  198.       i           : INTEGER;
  199.       Line, temp  : ARRAY [0..255] OF CHAR;
  200.   BEGIN
  201.     IF CommonData.Usespecial = cstrunk2 THEN
  202.       Do1Line(dx + x1, Line);
  203.       Do1Line(dy + y1, temp);
  204.       MagicStrings.Append(' ', Line);
  205.       MagicStrings.Append(temp, Line);
  206.       MagicStrings.Append(' b2 ', Line);
  207.       Do1Line(x2 - x1, temp);
  208.       MagicStrings.Append(temp, Line);
  209.       Do1Line(y2 - y1, temp);
  210.       MagicStrings.Append(' ', Line);
  211.       MagicStrings.Append(temp, Line);
  212.       Do1Line(x3 - x1, temp);
  213.       MagicStrings.Append(' ', Line);
  214.       MagicStrings.Append(temp, Line);
  215.       Do1Line(y3 - y1, temp);
  216.       MagicStrings.Append(' ', Line);
  217.       MagicStrings.Append(temp, Line);
  218.       WriteLn(FileHandle, Line);
  219.      ELSE
  220.       IF anzahl<=MaxBezPts THEN
  221.         i := anzahl;
  222.        ELSE
  223.         i := MaxBezPts;
  224.       END;
  225.       ComputeRealBezier(BezierArray, i, x1, y1, x2, y2, x3, y3);
  226.       OldX := myentier(10.0 * BezierArray[0]);
  227.       OldY := myentier(10.0 * BezierArray[1]);
  228.       FOR i:=1 TO anzahl DO
  229.         CurrX := myentier(10.0 * BezierArray[2*i  ]);
  230.         CurrY := myentier(10.0 * BezierArray[2*i+1]);
  231.         DoBetterLine(10 * LONG(dx + Object^.Code[1]) + OldX,
  232.                      10 * LONG(dy + Object^.Code[2]) + OldY,
  233.                      10 * LONG(dx + Object^.Code[1]) + CurrX,
  234.                      10 * LONG(dy + Object^.Code[2]) + CurrY);
  235.         OldX := CurrX;
  236.         OldY := CurrY;
  237.       END;
  238.     END;
  239.   END WriteBezier;
  240.  
  241.   PROCEDURE MakeCircles1(Object : ObjectPtrTyp);
  242.   VAR startangle, endangle, xradius, yradius, i : INTEGER;
  243.   BEGIN
  244.     startangle := 0;
  245.     endangle   := 360;
  246.     xradius    := Object^.Code [3];
  247.     yradius    := Object^.Code [3];
  248.     CASE VAL(DrawObjectTyp, Object^.Code [0]) OF
  249.      Arc :
  250.            startangle := Object^.Code [4];
  251.            endangle   := startangle + Object^.Code [5]; |
  252.      Ellipse :
  253.            yradius    := Object^.Code [4]; |
  254.      Oval :
  255.            CASE VAL(TextPosTyp, Object^.Code[4]) OF
  256.              LeftTop  : startangle := 090; endangle := 180; |
  257.              Left     : startangle := 090; endangle := 270; |
  258.              LeftBot  : startangle := 180; endangle := 270; |
  259.              Top      : startangle := 000; endangle := 180; |
  260.              Bottom   : startangle := 180; endangle := 360; |
  261.              RightTop : startan